home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / direct1a / form1.frm < prev   
Text File  |  1999-10-10  |  3KB  |  103 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   4  'Fixed ToolWindow
  4.    Caption         =   "LRS - Directory Creator"
  5.    ClientHeight    =   1710
  6.    ClientLeft      =   45
  7.    ClientTop       =   285
  8.    ClientWidth     =   3390
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   1710
  13.    ScaleWidth      =   3390
  14.    ShowInTaskbar   =   0   'False
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.TextBox Text4 
  17.       Height          =   285
  18.       Left            =   1440
  19.       TabIndex        =   3
  20.       Top             =   840
  21.       Width           =   1815
  22.    End
  23.    Begin VB.TextBox Text3 
  24.       Height          =   285
  25.       Left            =   1440
  26.       TabIndex        =   2
  27.       Top             =   480
  28.       Width           =   1815
  29.    End
  30.    Begin VB.TextBox Text2 
  31.       Height          =   285
  32.       Left            =   1440
  33.       TabIndex        =   1
  34.       Top             =   120
  35.       Width           =   1815
  36.    End
  37.    Begin VB.CommandButton Command1 
  38.       Caption         =   "Create"
  39.       Height          =   495
  40.       Left            =   120
  41.       TabIndex        =   0
  42.       Top             =   120
  43.       Width           =   1215
  44.    End
  45.    Begin VB.Label Label1 
  46.       Alignment       =   2  'Center
  47.       Height          =   255
  48.       Left            =   120
  49.       TabIndex        =   4
  50.       Top             =   1320
  51.       Width           =   3135
  52.    End
  53. End
  54. Attribute VB_Name = "Form1"
  55. Attribute VB_GlobalNameSpace = False
  56. Attribute VB_Creatable = False
  57. Attribute VB_PredeclaredId = True
  58. Attribute VB_Exposed = False
  59. Option Explicit
  60.  
  61. '######################################################
  62. '# This program shows how to create nested directories
  63. '# even if one of the directories in the path already
  64. '# exists!
  65. '######################################################
  66.  
  67.  
  68. Private Sub Command1_Click()
  69.     CreateNewDirectory "C:\" & Text2.Text & "\" & Text3.Text & "\" & Text4.Text
  70.     Label1.Caption = "Created: C:\" & Text2.Text & "\" & Text3.Text & "\" & Text4.Text
  71.     Text4.Text = ""
  72.     Text4.SetFocus 'So you can make more subdirectories
  73.     
  74. 'Here the program can proceed to save a file in whichever folder is indicated.
  75.  
  76. End Sub
  77.  
  78. Sub CreateNewDirectory(DirName As String)
  79.     Dim NewLen As Integer
  80.     Dim DirLen As Integer
  81.     Dim MaxLen As Integer
  82.     
  83.     NewLen = 4
  84.     MaxLen = Len(DirName)
  85.     If Right$(DirName, 1) <> "\" Then
  86.         DirName = DirName + "\"
  87.         MaxLen = MaxLen + 1
  88.     End If
  89.     On Error GoTo DirError
  90.     
  91. MakeNext:
  92.     DirLen = InStr(NewLen, DirName, "\")
  93.     MkDir Left$(DirName, DirLen - 1)
  94.     NewLen = DirLen + 1
  95.     If NewLen >= MaxLen Then
  96.         Exit Sub
  97.     End If
  98.     GoTo MakeNext
  99.  
  100. DirError:
  101.     Resume Next
  102. End Sub
  103.